COMMENT ⊗   VALID 00024 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	.TITLE SUBR
C00008 00003	"GETSYM" - FETCHES THE DESCRIPTOR BLOCK FOR A GIVEN STRING NAME
C00013 00004	"SEEKNM" - DECODES NAME INTO PTR TO SYMBOL BLOCK
C00016 00005	"GETTR2"  - IDENTIFIES TRANS NAME AND INITIALIZES VALUE IF NECESSARY
C00018 00006	"GETVAR"&"PRTVAR" - INTEGER VARIABLE ROUTINES
C00021 00007	"GTOKEN","PTOKEN" - LOCATES AND PRINTS SEPARATOR WORDS
C00024 00008	"GETALW" - DECODES ALWAYS SWITCH
C00025 00009	"GETAOP"&"PTSAOP" - DECODES AND PRINTS ARITHMETIC OPERATIONS
C00027 00010	"GETCMP"&"CHK__"  - DECODING AND EVAL RTNS FOR COMPARISON OPERATORS
C00029 00011	RETURNS PTR TO LABEL DATA BLOCK IN R0 GIVEN STRING NAME IN SG
C00033 00012	"GETSTR" - SUBR. TO SAVE STRING POINTER AND ADVANCE SG REGISTER
C00034 00013	"PACNME" - SUBR. TO PACK A SYMBOLIC NAME INTO A OUTPUT BUFFER
C00036 00014	"PTRTRN" - SUBR. TO PRINT A TRANSFORMS NAME AND DATA
C00038 00015	"PTRANS" - SUBR. TO PRINT A TRANSFORMS X,Y,Z,O,A,T
C00040 00016	"PSTEP"  - SUBR. TO PRINT MOTION INSTRUCTION OUT ON TTY
C00043 00017	"MODTRN" - SUBR. TO PERMIT MODIFICATION OF EXISTING TRANSFORMS
C00046 00018	"EVAL"   - EVALUATES A 5TH ORDER POLYNOMIAL 
C00049 00019	"TIMER"  - COMPUTE TOTAL MOTION TIME
C00052 00020	"GETBLK" - FREE STORAGE ALLOCATOR
C00056 00021	"RELBLK" - RETURNS FREE STORAGE BLOCK 
C00058 00022	"TYPERR" - TYPES OUT ERROR MESSAGES
C00061 00023	ERROR CODE BITS
C00064 00024	ERROR MESSAGE STRINGS
C00068 ENDMK
C⊗;
.TITLE SUBR

;"PUSARG" - DECODES A FUNCTION AND ITS ARGUMENTS

;THIS ROUTINES DECODES A STRING FUNCTION NAME AND LOCATES ITS SYMBOL
;DATA BLOCK.  THE ARGUMENTS OF THE FUNCTION ARE THEN DECODED AND LEFT
;ON THE STACK.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#HASTAB,R0	;PTR TO SYMBOL HASH TABLE
;		MOV	#TYPE,R1	;TYPE OF FUNCTION TO DECODE
;		JSR	PC,PUSARG
;		BCS	ERROR		;SET IF ERROR OCCURS
;
;IF NO ERROR OCCURS, R0 ← PTR TO SYMBOL DATA BLOCK AND A BLOCK OF
;EIGHT WORDS ARE LEFT ON THE STACK.  THE WORDS ON THE STACK ARE USED
;TO STORE THE FUNCTION ARGUMENTS THAT ARE DECODED.  THE FIRST
;ARGUMENT HAS THE LOWEST CORE ADDRESS.  IF AN ERROR OCCURS, THE C
;BIT IS SET, THE STACK IS LEFT UNALTERED AND R1 IS USED TO INDICATE
;THE TYPE OF ERROR:
;
;	R1 = 0, NO SYMBOLIC FUNCTION NAME FOUND
;	R1 ≠ 0, ERROR MESSAGES IN R1

;REGISTERS USED:
;	ALL REGISTERS EXCEPT R4 ARE ALTERED

PUSARG:	JSR	PC,GETSYM	;GET THE FUNCTION SYMBOL DATA BLK
	BCC	GOTFUN		
	MOV	R1,R1		;ERROR CODE ALREADY SPECIFIED?
	BGT	1$		;YES
	MOVB	(SG),(SG)	;END OF LINE?
	BEQ	1$
	MOV	#UNKFUN,R1	;NO, MUST BE AN UNKNOWN FUNCTION NAME
1$:	RTS	PC

GOTFUN:	SUB	#MAXARG,SP	;LEAVE ROOM ON STACK FOR ARGUMENTS
	MOV	MAXARG(SP),(SP)	;SAVE RETURN ADDRESS
	MOV	R0,-(SP)	;SAVE PTR TO SYMBOL DATA BLOCK
	TSTB	NUMARG(R0)	;ANY ARGUMENTS TO DECODE?
	BEQ	PUSDNE		;NO
	MOV	SP,R3		;PTR TO ARGUMENT STORAGE
	CMP	(R3)+,(R3)+
	MOV	R0,R2		;ADDR OF ARGUMENT TYPE INDICATORS
	ADD	#FUNARG,R2
	BR	NXTARG

GETARG:	BIC	#177601,R0	;WORD INDEX TO ARGUMENT TYPE
	BIT	#100,R0		;TOKEN?
	BEQ	NOTTOK
	BIC	#100,R0		;YES, SCAN FOR TOKEN
	MOV	TOKTBS(R0),R0
	JSR	PC,GTOKEN
	BR	.+6
NOTTOK:	JSR	PC,@ARGTAB(R0)	;GO DECODE REGULAR ARGUMENT
	BCC	GOTARG
	TST	R1		;BRANCH IF SYNTAX ERROR  
	BNE	ARGERR
	BITB	#1,(R2)		;ARG MISSING, ERROR IF NOT OPTIONAL
	BEQ	NOARG
	CLR	R0		;DEFAULT = 0
GOTARG:	TSTB	(R2)+		;NEED TO SAVE ARGUMENT?
	BMI	.+4
	MOV	R0,(R3)+	;SAVE ARGUMENT VALUE 
NXTARG:	MOVB	(R2),R0		;NEXT ARGUMENT TYPE
	BNE	GETARG		;END OF LIST?
PUSDNE:	MOV	#BADLIN,R1	;REST OF LINE SHOULD BE EMPTY
	CMPB	#' ,(SG)+	;IGNOR SPACE CHAR
	BEQ	.-4
	TSTB	-(SG)		;EOL?
	BNE	ARGERR		;JUMP IF GARBAGE HERE
	MOV	(SP)+,R0	;ALL DONE
	CLC
       	RTS	PC

NOARG:	MOV	#NOARGU,R1	;INDICATE NO ARGUMENT FOUND
ARGERR:	MOV	2(SP),R0	;THIS IS THE RETURN ADDRESS
	ADD	#MAXARG+4,SP	;CLEAR STACK
	SEC			;INDICATE ERROR
	JMP	(R0)

;END OF "PUSARG"
;"GETSYM" - FETCHES THE DESCRIPTOR BLOCK FOR A GIVEN STRING NAME

;THE FIRST WORD IN THE STRING POINTER BUFFER IS HASHED AND A SEARCH
;OF THE APPROPRIATE HASH BUCKET IS CONDUCTED.  LEGAL SYMBOLS CAN AT
;MOST HAVE 6 CHARACTERS.  THE FIRST CHARACTER MUST BE BETWEEN A-Z
;AND ALL OTHER CHARACTERS MUST BE EITHER ALPHABETIC (A-Z), NUMERIC (0-9),
;OR THE CHARACTER ".".  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#HASHTB,R0	;PTR TO HASH TABLE
;		MOV	#TYPE,R1	;NAME ID, EG. MOTION, MASTER
;		MOV	#STRING,SG	;STRING CONTAINING NAME
;		JSR	PC,GETSYM
;		BCS	ERROR		;SET IF ERROR
;
;IF SUCCESSFUL, R0 ← PTR TO SYMBOL DATA BLOCK AND SG IS LEFT 
;POINTING AT THE BREAK CHARACTER.   IF AN ERROR OCCURRED, THE C
;BIT IS SET AND R1 INDICATES THE TYPE OF ERROR:
;
;	R1 = 0, NO SYMBOLIC NAME FOUND
;	R1 > 0, TOO MANY CHARACTERS IN NAME, R1= ERROR CODE
;	R1 < 0, NO MATCH FOR NAME FOUND, R0 ← PTR TO LAST DATA BLK LINK
;		IN HASH BUCKET, R1 ← -# OF CHAR IN NAME, SG ← PTR TO
;		FIRST CHARACTER IN NAME.

;REGISTERS USED:
;	R0,R1,SG PASS ARGUMENTS AND MAY BE ALTERED

GETSYM:	MOV	R4,-(SP)	;SAVE REGISTERS
 	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)	;SAVE SYMBOL TYPE   

;HASH THE FIRST WORD

	CMPB	#' ,(SG)+	;IGNOR ALL LEADING SPACE CHARACTERS
	BEQ	.-4
	DEC 	SG   		;POINT TO FIRST NON-SPACE CHARACTER
	MOV	SG,R4    	;SAVE STRING POINTER
	MOV	#7,R1		;HASH AT MOST 6 CHARACTERS
	CLR	R2		;FORM HASH IN HERE
	BR	HASH0		;SYMBOLS START WITH A CHARACTER
HASH:	CMPB	#'.,(SG)	;IS IT A "."?
	BEQ	HASH1
	CMPB	#'0,(SG)	;INVALID CHAR IF LESS THAN ASC 0
	BGT	HASH2
	CMPB	#'9,(SG)	;0-9 ARE VALID CHARACTERS
	BGE	HASH1
HASH0:	CMPB	#'A,(SG)	;A-Z?
	BGT	HASH2
	CMPB	#'Z,(SG)
	BLT	HASH2
HASH1:	MOVB	(SG)+,R3	;GET THE GOOD CHARACTER
	ADD 	R3,R2		;ELSE ADD CHARACTERS TOGETHER
	SOB	R1,HASH 	;CHECK IF MORE THAN 6 CHAR. READ
	MOV	#BIGSYM,R1	;INDICATE TOO MANY CHARACTERS IN WORD
	BR	GTSERR
HASH2:	SUB	#7,R1		;CHECK IF ANY CHARACTERS FOUND
	BEQ	GTSERR   	;EXIT IF NO WORD BEFORE BREAK CHAR.
	BIC	#177740,R2	;USE 5 LSB AS HASH WORD INDEX
	ASL	R2		
	ADD	R2,R0		;ADD TO BASE ADDRESS OF TABLE

;GO SEARCH FOR SYMBOL

	MOV	R4,SG		;POINT TO START OF SYMBOL
	MOV	(R0),R3		;TEST IF ANY SYMBOLS IN BUCKET
	BEQ	GTSERR
GETSM1:	MOV	R3,R0
	BIT 	(SP),TYPBIT(R0)	;SAME TYPE OF SYMBOL?
	BEQ	40$		;NO
	ADD	#SYMNME,R3	;COMPARE NAME
	MOV	R1,R2
	NEG	R2
20$:	CMPB	(R3)+,(SG)+
	BNE	30$		;BRANCH IF NOT SAME
	SOB	R2,20$
	CMP	#-6,R1		;PERFECT MATCH IF 6 CHARACTERS
	BEQ	GTSDNE
	CMPB	(R3),#40	;ELSE THIS BETTER BE A SHORT SYM.
	BEQ	GTSDNE
30$:	MOV	R4,SG
40$:	MOV	LINK(R0),R3	;NEXT SYMBOL BLOCK
	BNE	GETSM1
	ADD	#LINK,R0

GTSERR:	SEC			;INDICATE ERROR
GTSDNE:	MOV	(SP),(SP)+	;DISCARD TYPE WORD 
       	MOV	(SP)+,R2	;RESTORE REGISTERS
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTS	PC

;END OF "GETSYM"
;"SEEKNM" - DECODES NAME INTO PTR TO SYMBOL BLOCK
 
;THESE ROUTINES DECODE THE NAMES OF PROGRAMS AND TRANSFORMATION
;VARIABLES INTO PTRS TO DATA SYMBOL BLOCKS.  A SAMPLE CALL TO ONE
;OF THESE ROUTINES FOLLOWS:
;
;		MOV	#STRING,SG	;POINT TO INPUT STRING
;		JSR	PC,GETTRN	;NO ARGUMENTS REQUIRED
;		BCS	ERROR		;CHECK FOR ERROR RETURN
;
;IF A SYMBOLIC NAME IS FOUND A SYMBOL BLOCK IS ALLOCATED IF THE
;NAME IS NOT ALREADY DEFINED.  IN EITHER CASE, THE C BIT IS LEFT
;CLEARED AND R0 ← PTR TO SYMBOL BLOCK.   IF NO SYMBOLIC NAME IS
;FOUND, C IS SET AND R1← 0, OTHERWISE C SET AND R1 ← ERROR CODE.

;REGISTERS USED:
;
;	R0,R1,SG PASSES ARGUMENTS AND ARE ALTERED

GETPRG:	MOV	#PROG,R1	;LOOK FOR A PROGRAM NAME
	MOV	#7,R0		;# OF WORDS IN SYMBOL BLOCK
	BR	SEEKNM

GETTRN:	MOV	#TRANS,R1	;LOOK FOR A TRANSFORM NAME
	MOV	#6,R0

SEEKNM:	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
       	MOV	#VARTAB,R0	;LOOK IN VARIABLE HASH TABLE
       	JSR	PC,GETSYM	;DECODE THE SYMBOL
	BCC 	GTTNX		;ALL DONE IF FOUND DEFINED SYMBOL BLK
	MOV	R1,R3		;CHECK ERROR CODE
	BPL	GTTNX		;EXIT IF SYNTAX ERROR OR NO NAME
	MOV	R0,R2   	;SAVE PTR TO LAST LINK IN BUCKET
	MOV	(SP),R0		;GET A F.S. BLK OF WORDS
	JSR	PC,GETBLK
	BCS	GTTNX		;EXIT IF NO F.S. LEFT
	MOV	R0,(R2) 	;ADD SYMBOL TO HASH TABLE LIST
	MOV	R0,R1		;INITIALIZE SYMBOL BLOCK
	CMP	(R1)+,(R1)+
	MOV	2(SP),(R1)+
	MOV	R3,R2		;GET NUMBER OF CHARACTERS IN NAME
	NEG	R3
	MOVB	(SG)+,(R1)+	;SAVE SYMBOLIC NAME
	SOB	R3,.-2
	ADD	#6,R2		;NUMBER OF SPACES TO FILL
	BEQ	GOTNME
	MOVB	#40,(R1)+	;FILL SPACES
	SOB	R2,.-4
GOTNME:	CLC
GTTNX:	MOV	(SP)+,(SP)+	;DONT NEED THIS INFO ANYMORE
       	MOV	(SP)+,R2
	MOV	(SP)+,R3  
	RTS	PC

;END OF "GETTRN" & "GETPRG"
;"GETTR2"  - IDENTIFIES TRANS NAME AND INITIALIZES VALUE IF NECESSARY

;THIS ROUTINE DECODES A TRANSFORM NAME IN THE SAME FASHION AS "GETTRN",
;BUT IN ADDITION, IT INITIALIZE THE TRANSFORMATION LOCATION TO THE
;CURRENT ARM POSITION IF THE TRANSFORM NAME IS FOLLOWED BY A "!".

GETTR2:	JSR	PC,GETTRN	;LOOK FOR A TRANSFORM NAME
	BCS	20$		;ERROR?

	MOV	R2,-(SP)
	MOV	R3,-(SP)
	CMPB	#' ,(SG)+	;IGNOR TRAILING SPACE CHARACTERS
	BEQ	.-4
	CMPB	#'!,-(SG)	;INITIALIZE TRANS TO CURRENT POSITION?
	BNE	10$
	INC	SG		;YES
	MOV	R0,R3		;SET TRANS EQUAL TO CURRENT ARM LOCATION
	JSR	PC,HERESB
	MOV	R3,R0
	BR	.+4
10$:	CLC			;SIGNAL TRANS NAME FOUND
	MOV	(SP)+,R3
	MOV	(SP)+,R2

20$:	RTS	PC
;"GETVAR"&"PRTVAR" - INTEGER VARIABLE ROUTINES
 
;THESE ROUTINES ARE USED TO DECODE AND PRINT INTEGER
;VARIABLES AND CONSTANTS.  SAMPLE CALLS TO THESE ROUTINES
;FOLLOW:
;
;		MOV	#STRING,SG	;DECODE VAR/CONT
;		JSR	PC,GETVAR	;NO ARGUMENTS REQUIRED
;		BCS	ERROR		;CHECK FOR ERROR RETURN
;
;		MOV	#STRING,SG	;ADD VAR/CONT TO STRING
;		MOV	#WORDPTR,R0
;		JSR	PC,PTRVAR
;
;THE ERROR CODES RETURNED BY THESE ROUTINES ARE THE SAME AS
;THOSE OF "GETSYM".

;REGISTERS USED:
;	R0,R1,SG PASS ARGUMENTS AND ARE ALTERED

GETVAR:	JSR	PC,GETVA2	;LOOK FOR INTEGER VARIABLE
	BCC	GETVDN		;ALL DONE IF FOUND SYMBOL BLOCK
	JSR	PC,GETINT	;ELSE MIGHT BE A INTEGER CONSTANT
	BCS	GETVDN		;VALID INTEGER VARIABLE?

	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R0,R3		;YES, SEARCH PROPER HASH BUCKET
	BIC	#177740,R0	;USE LOW 5 BITS FOR INDEX
	ASL	R0
	ADD	#VARTAB,R0
	MOV	R0,R2
	MOV	(R2),R0		;TEST IF ANY SYMBOLS IN BUCKET
	BEQ	30$
10$:	MOV	R0,R2
	CMP	R3,(R2)+	;MATCHED INTEGER VALUE?
	BNE	20$		;NO
	TSTB	TYPBIT(R0)	;INTEGER CONSTANT?
	BEQ	40$		;PERFECT MATCH
20$:	MOV	(R2),R0		;NEXT ITEM IN LIST
	BNE	10$		;END OF LIST?
30$:	MOV	#3,R0		;YES, ADD CONSTANT TO LIST
	JSR	PC,GETBLK
	BCS	40$		;OUT OF FREE STORAGE?
	MOV	R0,(R2)		;LINK IN
	MOV	R3,(R0)		;AND SAVE VALUE AND TYPE
40$:	MOV	(SP)+,R3
	MOV	(SP)+,R2
GETVDN:	RTS	PC

	
GETVA2:	MOV	#INTVAR,R1	;ONLY LOOK FOR AN INTEGER VARIABLE
	MOV	#6,R0
	JSR	PC,SEEKNM
	RTS	PC


PTRVAR:	TSTB	TYPBIT(R0)	;VARIABLE OR CONSTANT?
	BEQ	1$
	JSR	PC,PACNMS	;VARIABLE
	BR	2$
1$:	MOV	(R0),R0		;CONSTANT
	JSR	PC,PTSINT
	CLRB	-(SG)		;DELETE DECIMAL POINT
2$:	RTS	PC


;END OF INTEGER VARIABLE ROUTINES
;"GTOKEN","PTOKEN" - LOCATES AND PRINTS SEPARATOR WORDS
 
;THESE ROUTINES ARE USED FOR SCANNING AN INPUT LINE FOR A SPECIFIC
;ASC WORD AND PUTTING THE WORD IN A SPECIFIED ASC STRING.  A
;SAMPLE CALLING SEQUENCE TO THESE ROUTINES FOLLOWS:
;
;		MOV	#STRING,SG
;		MOV	#WORD,R0
;		JSR	PC,PTOKEN
;
;		MOV	#STRING,SG
;		MOV	#WORD,R0
;		JSR	PC,GTOKEN
;		BCS	ERROR		;SET IF WORD NOT FOUND
;
;THE POSSIBLE REGISTER STATES AFTER THE EXECUTION OF "GTOKEN"
;ARE AS FOLLOWS:
;	R1=?     C=0   STRING FOUND
;	R1=0     C=1   NO STRING FOUND BEFORE EOL
;	R1=ERROR C=1   NO STRING FOUND BEFORE A BREAK CHAR.
;SG IS ALWAYS LEFT POINTING TO THE FIRST CHARACTER FOLLOWING THE
;DESIRED STRING AND R0 IS GARBAGED.

;REGISTERS USED:
;	R0,R1,SG ARE ALTERED

GTOKEN:	CLR	R1		;ASSUME NO ERRORS
	CMPB	#40,(SG)+	;IGNOR LEADING SPACE CHAR
	BEQ	.-4
	TSTB	-(SG)		;END OF STRING?
	BEQ	2$
	MOV	#SYNERR,R1	;ASSUME SYNTAX ERROR
1$:	CMPB	(R0)+,(SG)+	;SAME CHARACTERS?
	BNE	2$
	TSTB	(R0)		;END OF STRING?
	BNE	1$		;NO
	BR	.+4
2$:	SEC
	RTS	PC	

PTOKEN:	MOVB	(R0)+,(SG)	;PACK STRING FOLLOWED BY 0
	BEQ	1$
	CMPB	#' ,(SG)+	;SPACE CHARACTER?
	BNE	PTOKEN		;NO
	CLRB	-(SG)		;DONT PRINT TRAILING SPACES
1$:	RTS	PC


;DEFINED TOKENS, THESE CAN BE FOLLOWED BY ANY CHARACTER

KCOMMA:	.ASCIZ	/,/
KEQUAL:	.ASCIZ	/=/

;DEFINED TOKENS, THESE MUST BE FOLLOWED BY A SPACE CHARACTER

KINTO:	.ASCIZ	/INTO /
KTHEN:	.ASCIZ	/THEN /
KPROG:	.ASCIZ	/DEFPRO /
KBY:	.ASCIZ	/BY /
	.EVEN

;END "GTOKEN","PTOKEN"
;"GETALW" - DECODES ALWAYS SWITCH
 
;THE WORD "ALWAYS" IS A OPTIONAL SWITCH THAT CAN FOLLOW CERTAIN
;INSTRUCTIONS.  THIS ROUTINE RETURNS A POINTER TO THE "ALWAYS"
;SYMBOL BLOCK IF THE SWITCH IS PRESENT, ELSE IT RETURNS THE
;STANDARD ERROR CODES.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#STRING,SG	;POINT TO INPUT STRING
;		JSR	PC,GETSTR

;REGISTERS USED:
;	R0,SG PASSES ARGUMENTS AND ARE ALTERED

GETALW:	MOV	#KALWAY,R0	;ALWAYS
	JSR	PC,GTOKEN
	MOV	#SYMALW,R0	;PTR TO SYMBOL BLOCK IF FOUND
	RTS	PC

SYMALW==.-SYMNME		;DUMMY SYMBOL BLOCK
KALWAY:	.ASCII	/ALWAYS/
	.BYTE	0,0

;END OF "GETALW"
;"GETAOP"&"PTSAOP" - DECODES AND PRINTS ARITHMETIC OPERATIONS
 
;"GETAOP" RETURNS AN INDEX WHICH IDENTIFIES ONE OF THE ARITHMETIC
;OPERATIONS + - * % /.  ELSE IF NO ARITHMETIC OPERATION IS PRESENT AND NO
;OTHER CHARACTERS ARE FOUND BEFORE THE END OF LINE THE INDEX IS ZERO,
;OTHERWISE THE STANDARD ERROR CODES ARE RETURNED.  A SAMPLE CALLING
;SEQUENCE FOLLOWS:
;
;		MOV	#STRING,SG	;POINT TO INPUT STRING
;		JSR	PC,GETAOP
;
;"PTSAOP" ADDS THE ARITHMETIC OPERATION ASC REPRESENTATION TO THE
;CURRENT STRING.

;REGISTERS USED:
;	R0,R1,SG PASSES ARGUMENTS AND ARE ALTERED

GETAOP:	CMPB	#' ,(SG)+	;IGNOR LEADING SPACE CHARACTERS
	BEQ	.-4
	CLR	R0		;ASSUME NO OPERATION FOUND
	TSTB	-(SG)		;EOL?
	BEQ	3$		;YES, ALL DONE
	MOV	#5,R0
1$:	CMPB	OPERS-1(R0),(SG);COMPARE TO ARITHMETIC OPERATORS
	BEQ	2$
	SOB	R0,1$
	MOV	#NOOPER,R1	;SIGNAL ERROR
	SEC
	BR	3$
2$:	INC	SG
	ASL	R0		;CONVERT TO WORD INDEX
3$:	RTS	PC


PTSAOP:	ASR	R0		;CONVERT TO BYTE INDEX
	BEQ	1$		;NOTHING TO DO?
	MOVB	OPERS-1(R0),(SG)+;PACK AWAY OPERATOR
	CLRB	(SG)
1$:	RTS	PC


OPERS:	.ASCII  \*/+-%\
	.EVEN

;END OF "GETAOP"&"PTSAOP"
;"GETCMP"&"CHK__"  - DECODING AND EVAL RTNS FOR COMPARISON OPERATORS

;"GETCMP" USES THE SYMBOL SCANNING ROUTINE "GETSYM" TO IDENTIFY ANY
;COMPARISON OPERATOR PRESENT.  IT RETURNS THE STANDARD ERROR CODES IF
;NO OPERATOR IS FOUND ELSE A POINTER TO THE OPERATOR SYMBOL BLOCK IS
;RETURNED.
;
;THE COMPARISON OPERATOR ROUTINES EVALUATE THE STATE OF THA CPU CONDITION
;CODE BITS AND RETURN WITH THE C BIT CLEARED IF THE CONDITION IS SATISFIED
;ELSE THE C BIT IS SET.

GETCMP:	MOV	#FUNTAB,R0	;DECODE OPERATOR
	MOV	#CMPOPR,R1
	JSR	PC,GETSYM
	MOV	#BADCMP,R1	;ERROR CODE IF NECESSARY
	RTS	PC

CHKEQ:	BEQ	.+4
	SEC
	RTS	PC

CHKNE:	BNE	.+4
	SEC
	RTS	PC

CHKGT:	BGT	.+4
	SEC
	RTS	PC

CHKGE:	BGE	.+4
	SEC
	RTS	PC

CHKLT:	BLT	.+4
	SEC
	RTS	PC

CHKLE:	BLE	.+4
	SEC
	RTS	PC

;END OF COMPARISON OPERATOR RTNS
;RETURNS PTR TO LABEL DATA BLOCK IN R0 GIVEN STRING NAME IN SG

GETLBL:	JSR	PC,GETINT	;LABELS ARE INTEGER NUMBERS
	BCS	GETLDN

	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	#BADLBL,R1	;ERROR CODE
	MOV	R0,R3		;MUST BE IN THE RANGE 0 TO '77777
	SEC
	BLT	40$		;SIGNAL IF OUT OF RANGE
	MOV	@#LPROG,R2	;SEARCH PROG. LABEL LIST FOR LABEL
	ADD	#LABELS,R2
	MOV	(R2),R0		;ANY LABELS DEFINED?
	BEQ	30$
10$:	MOV	R0,R2
	CMP	R3,LABEL(R2)	;FOUND LABEL?
	BEQ	40$		;YES
20$:	TST	(R2)+		;NEXT ITEM IN LIST
	MOV	(R2),R0
	BNE	10$		;END OF LIST?
30$:	MOV	#3,R0		;YES, ADD CONSTANT TO LIST
	JSR	PC,GETBLK
	@Eπ&$h`H∩$w∨+(↓∨A
I
A'Q∨%β∂∀}~∀∪5∨,∪$@XQ$d$∩∩w→%≥⊗A∪8~∀∪≠=,∪$f1→β¬0Q$`R$wβ≥λ↓'β-
↓→β¬0A≥β≠∀~∀h`⊂t∪≠∨X∩Q' $VY$f4∀∪≠∨	(SP)+,R2

GETLDN:	RTS	PC


;PRINT THE LABEL OF AN INSTRUCTION

PRTLBL:	JSR	PC,FNDLBL	;GET LABEL DATA BLOCK
	BCS	10$		;NOT LABELED?
	MOV	LABEL(R1),R0
	JSR	PC,PRTINT
	MOVB	#' ,-1(SG)	;DONT WANT "." FOLLOWING LABEL
	BR	20$
10$:	MOV	#7,R1		;FILL WITH SPACE CHARACTERS
	MOVB	#' ,(SG)+
	SOB	R1,.-4
20$:	RTS	PC


;PRINT A LABEL ARGUMENT

PTSLBL:	MOV	LABEL(R0),R0	;R0 ← LABEL
	JSR	PC,PTSINT
	CLRB	-(SG)		;DON'T WANT "." FOLLOWING LABEL
	RTS	PC


;GIVEN THE ADDRESS OF A INSTRUCTION IN R0, IF THE INSTRUCTION HAS A LABEL,
;THE LABEL DATA ADDRESS IS CLEARED.  R1 IS GARBAGED

CLRLBL:	JSR	PC,FNDLBL	;GET LABEL DATA BLOCK
	BCS	.+4		;NOT LABELED?
	CLR	(R1)		;CLEAR JUMP ADDRESS
	RTS	PC


;RETURNS TO F.S. ALL LABEL DATA BLOCKS OF CURRENT LABEL PROGRAM
;GARBAGES R0,R1,R2

DELLBL:	MOV	@#LPROG,R2	;GET PTR TO LABEL LIST
	ADD	#LABELS,R2
	BR	20$
10$:	CLR	(R2)		;ZERO LINKS
	MOV	R0,R2		;RELEASE F.S. BLOCK
	JSR	PC,RELBLK
20$:	MOV	(R2),R0		;ANY MORE LABELS TO DELETE?
	BNE	10$		;YES
	RTS	PC


;GIVEN THE ADDRESS OF A LABELED INSTRUCTION IN R0, THIS ROUTINE RETURNS
;A POINTER TO THE LABEL DATA BLOCK IN R1

FNDLBL:	SEC			;LABELED INSTRUCTION?
	BIT	#1,2(R0)
	BEQ	30$
	MOV	@#LPROG,R1	;SEARCH FOR LABELED ADDR IN PROG LABEL LIST
	MOV	LABELS(R1),R1
	BR	20$
10$:	MOV	LINK(R1),R1	;MOVE TO NEXT LABEL
20$:	CMP	R0,(R1)		;FOUND LABEL?
	BNE	10$		;NO
30$:	RTS	PC


;END OF INSTRUCTION LABEL ROUTINES
;"GETSTR" - SUBR. TO SAVE STRING POINTER AND ADVANCE SG REGISTER
 
;THE STRING POINTER IS SAVED IN R0 AND THE POINTER IN THE SG
;REGISTER IS ADVANCED TO THE END OF STRING CHARACTER.  A
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#STRING,SG	;POINT TO INPUT STRING
;		JSR	PC,GETSTR
;
;THIS ROUTINE NEVER RETURNS A ERROR CODE.

;REGISTERS USED:
;	R0,SG PASSES ARGUMENTS AND ARE ALTERED

GETSTR:	MOV	SG,R0   	;SAVE STRING POINTER
	TSTB	(SG)+		;ADVANCE TO END OF LINE
	BNE	.-2
	DEC	SG		;LEAVE IT POINTING AT A NULL
	RTS	PC

;END OF "GETSTR"
;"PACNME" - SUBR. TO PACK A SYMBOLIC NAME INTO A OUTPUT BUFFER

;THE SYMBOL DATA BLOCK ADDRESS FOR THE SYMBOL TO BE PACKED 
;MUST BE LOADED INTO R0.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#SYMBLK,R0
;		JSR	PC,PACNME
;
;NO ERROR MESSAGE IS RETURNED BY THIS ROUTINE.

;REGISTERS USED:
;
;	R0 PASSES ARGUMENT AND IS NOT MODIFIED
;	R1,SG ARE GARBAGED

PACNME:	CLR	R1		;PACK ALL 6 CHARACTERS
	BR	PACNM0

PACNMS:	MOV	#40,R1		;DONT PACK SPACE CHARACTERS
	
PACNM0:	MOV	R0,-(SP)
	BEQ	3$		;NOTHING TO DO?
	MOV	R2,-(SP)
	MOV	#6,R2		;SIX CHARACTERS AT MOST
	ADD	#SYMNME,R0	;GET ADDRESS OF CHARACTERS
1$:	CMPB	R1,(R0)		;END?
	BEQ	2$
	MOVB	(R0)+,(SG)+	;PACK AWAY THAT NAME
	SOB	R2,1$
2$:	MOV	(SP)+,R2
3$:	MOV	(SP)+,R0
	CLRB	(SG)		;MARK END OF STRING
	RTS	PC

;END OF "PACNME"
;"PTRTRN" - SUBR. TO PRINT A TRANSFORMS NAME AND DATA

;THE TRANS' SYMBOL DATA BLOCK ADDRESS MUST BE LOADED INTO R0.  A 
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#TRNSYM,R0	;LOAD TRANSFORM ADDRESS
;		MOV	#TFFLAG,R1	;1 IF "TF" LISTING,ELSE 0
;		JSR	PC,PTRTRN
;
;AFTER EXECUTION OF PTRTRN, THE COMPUTED EULER ANGLES ARE LEFT IN
;THE ARRAY "EANGLE".  THERE IS NO ERROR MESSAGE RETURNED.

;REGISTERS USED:
;	R0,R1  PASS ARGUMENTS AND R1 IS MODIFIED
;	SG ARE GARBAGED

PTRTRN:	MOV	R0,-(SP)
	MOV	#OUTBUF,SG	;PACK THE TRANS NAME IN HERE
	MOV	R1,-(SP)
	BEQ	NOTTF		;TF LISTING?
	MOV	#43124,(SG)+	;YES, PACK "TF"
	MOVB	#40,(SG)+
NOTTF:	JSR	PC,PACNME
	MOVB	#' ,(SG)+
	CLRB	(SG)
	TST	(SP)+		;NEED A COMMA IF "TF"
	BEQ	NOTTF2
	MOVB	#',,(SG)+
	CLRB	(SG)
NOTTF2:	MOV	#OUTBUF,SG	;TYPE THE NAME
	JSR	PC,TYPSTR
	MOV	(R0),R0		;GET PTR TO TRANS DATA
	BNE	GOTDAT
	MOV	#PTRMES,SG	;SAY NOT DEFINED IF NO DATA
	JSR	PC,LINOUT
	BR	.+6
GOTDAT:	JSR	PC,PTRANS	;PRINT X,Y,Z,O,A,T
	MOV	(SP)+,R0
	RTS	PC

PTRMES:	.ASCIZ	/TRANSFORMATION DATA NOT YET DEFINED/
	.EVEN

;END OF "PTRTRN"
;"PTRANS" - SUBR. TO PRINT A TRANSFORMS X,Y,Z,O,A,T

;THE TRANS DATA ADDRESS MUST BE LOADED INTO R0.  A SAMPLE CALLING 
;SEQUENCE FOLLOWS:
;
;		MOV	#TRANS,R0	;LOAD TRANSFORM ADDRESS
;		JSR	PC,PTRANS
;
;AFTER EXECUTION OF PTRANS, THE COMPUTED EULER ANGLES ARE LEFT IN
;THE ARRAY "EANGLE".  THERE IS NO ERROR MESSAGE RETURNED.

;REGISTERS USED:
;	R0 PASSES ARGUMENT AND IS NOT MODIFIED
;	R1,SG ARE GARBAGED

PTRANS:	MOV	R0,-(SP)	;SAVE TRANSFORM POINTER
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	#EANGLE,R1	;CONVERT TRANS TO EULER ANGLES
	JSR	PC,EULER
	MOV	#OUTBUF,SG	;POINT TO START OF OUTPUT STRING
	MOV	#EANGLE,R2
       	MOV	#3,R3		;SET LOOP COUNT TO OUTPUT X,Y,Z
PTRAN1:	MOV	(R2)+,R0 	;CONVERT DISTANCE TO ASC
	JSR	PC,PRTDIS
	JSR	PC,PRTCMA
	SOB	R3,PTRAN1	
       	MOV	#3,R3		;SET LOOP COUNT TO OUTPUT O,A,T
PTRAN2:	MOV	(R2)+,R0 	;CONVERT ANGLES TO ASC
	JSR	PC,PRTANG
	JSR	PC,PRTCMA
	SOB	R3,PTRAN2
	SUB	#2,SG		;PUT IN A NULL CHARACTER
	CLRB	(SG)
	MOV	#OUTBUF,SG	;OUTPUT THE STRING
	JSR	PC,LINOUT
	MOV	(SP)+,R3	;RESTORE REGISTERS
	MOV	(SP)+,R2
       	MOV	(SP)+,R0
	RTS	PC

HTRANS:	.ASCII	/       /
HTRAN2:	.ASCII	/   X        Y        Z         O/
	.ASCIZ	/        A        T/
	.EVEN

;END OF "PTRANS"
;"PSTEP"  - SUBR. TO PRINT MOTION INSTRUCTION OUT ON TTY

;A POINTER TO THE DATA BLOCK CONTAINING THE MOTION INSTRUCTION MUST
;BE LOADED INTO R1 AND THE STEP NUMBER MUST BE SET IN R0.  IF THE
;DATA BLOCK POINTER IS NON-ZERO, THE MOTION INSTRUCTION IS CONVERTED
;TO ASC ALONG WITH ITS STEP NUMBER AND THEY ARE TYPED OUT.
;OTHERWISE, NO TYPE OUT OCCURS.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#STEPNUM,R0
;		MOV	#BLKPTR,R1
;		JSR	PC,PSTEP
;
;AT THE END OF EXECUTION, "OUTBUF" IS ALWAYS LEFT WITH AT LEAST
;THE STEP NUMBER CODED IN ASC.  THERE IS NO ERROR  MESSAGE
;RETURNED FROM THIS ROUTINE.

;REGISTERS USED:
;
;	R0,R1 PASS ARGUMENTS AND R0 IS ALTERED
;	SG IS GARBAGED

PSTEP:	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)	;SAVE STEP POINTER
	MOV	#OUTBUF-2,SG	;DONT NEED +/- OR 1ST DIG
	JSR	PC,PRTINT	;STEP NUMBER
	MOV	(SP),R0		;ALL DONE IF NO INSTRUCTION
	BEQ	PSTDNE
	MOV	R0,R4
	JSR	PC,PRTLBL	;PACK LABEL VALUE
	TST	(R4)+
	MOV	(R4)+,R0	;MOTION FUNC. SYMBOL BLOCK PTR
	BIC	#1,R0
	JSR	PC,PACNMS	;NAME TO ASCII
	TSTB	NUMARG(R0)	;ANY ARGUMENTS TO DECODE?
	BEQ	PSPTYP		;NO
	MOV	R0,R3		;SPECIFICATIONS OF ARGUMENTS
	ADD	#FUNARG,R3
       	CMPB	#STRING,(R3)	;SPECIAL CASE OF 1 STRING ARG
	BNE	NXTPAC
       	MOVB	(R4)+,(SG)+	;PACK AWAY STRING ARGUMENT
	BNE	.-2
	BR	PSPTYP

PACARG:	BMI	.+4		;NEEDS ARGUMENT?
	MOV	(R4)+,R0	;YES
	MOVB	#' ,(SG)+	;SEPARATE ARGUMENTS WITH SPACE CHAR
	BIC	#177601,R1	;CONVERT TO WORD INDEX
	BIT	#100,R1		;TOKEN?
	BEQ	1$
	BIC	#100,R1		;YES
	MOV	TOKTBS(R1),R0
	JSR	PC,PTOKEN	;PACK TOKEN
	BR	NXTPAC
1$:	JSR	PC,@PRTTAB(R1)	;CONVERT ARGUMENT TO ASC
NXTPAC:	MOVB	(R3)+,R1	;NEXT ARGUMENT TYPE
	BNE	PACARG		;END OF LIST?

PSPTYP:	MOV	#OUTBUF,SG	;TYPE THE MOTION COMMAND
	JSR	PC,LINOUT
PSTDNE:	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTS	PC

;END OF "PSTEP"
;"MODTRN" - SUBR. TO PERMIT MODIFICATION OF EXISTING TRANSFORMS

;THIS SUBROUTINE IS CALLED TO ALLOW THE USER TO EDIT EXISTING
;TRANSFORMS.  THE ONLY REQUIRED ARGUMENT TO THIS ROUTINE IS A TRANS
;POINTER LOADED INTO REGISTER R0.  EDITING IS CONTINUED INDEFINITLY
;UNTIL THE USER RESPONSES TO THE QUERY "CHANGES" WITH A NULL LINE 
;(I.E. NO REQUESTED CHANGES ).  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#TRANS,R0	
;		JSR	PC,MODTRN
;
;THERE IS NO ERROR RETURN FROM THIS ROUTINE

;REGISTERS USED:
;	R0 PASSES ARGUMENT AND IS NOT MODIFIED
;	R1,R2,R3,R4,SG ARE GARBAGED

MODTRN:	MOV	R0,-(SP)
       	MOV     #HTRANS+7,SG	;TYPE OUT THE COLUMN HEADER
	JSR	PC,LINOUT
	BR	MODT1
CHGTRN:	MOV	#EANGLE,R1	;CONVERT EULER ANGLES BACK TO TRANS
	MOV	(SP),R0
	JSR	PC,UNEUL
MODT1:	MOV	(SP),R0
       	JSR	PC,PTRANS	;TYPE OUT THIS TRANSFORM
	MOV     #CHGMES,SG	;ASK FOR CHANGES
	JSR	PC,LINOUT
	MOV	#INBUF,SG	;READ IN THE CHANGES
	JSR	PC,INSTR
	MOV	#EANGLE,R4	;EULER ANGLES ARE STORED IN HERE
	CLR	-(SP) 		;KEEP TRACK OF ANY CHANGES
	MOV	#GETDIS,R2	;READ IN THE THREE DISTANCES
MODT2:	MOV	#3,R3		;SET LOOP COUNTER
MODT3:	JSR	PC,(R2)
	BCC	ISCORR		;BRANCH IF A CORRECTION WAS TYPED IN
	TST	R1		;BRANCH IF ERROR ON INPUT
	BNE	MODERR
	TST	(R4)+		;NO CHANGE MADE
	BR	NOCORR
ISCORR:	MOV	R0,(R4)+	;CHANGE EULER ANGLE
	INC     (SP)  		;INDICATE CHANGE MADE
NOCORR:	JSR	PC,CLRCMA	;SKIP OVER COMMA
	BCC	MODCOM		;BRANCH IF NO ERROR
MODERR:	JSR	PC,TYPERR	;TYPE INPUT ERROR MESSAGE
	TST	(SP)+
	BR	MODT1
MODCOM:	SOB	R3,MODT3	;REPEAT FOR ALL NUMBERS
	CMP	#GETANG,R2	;REPEAT FOR 3 ANGLES
	BEQ	MODT4
	MOV	#GETANG,R2
	BR	MODT2
MODT4:	TST	(SP)+      	;REPEAT IF CORRECTIONS MADE
	BNE	CHGTRN
	MOV	(SP)+,R0
       	RTS	PC			

CHGMES:	.ASCIZ	/CHANGE?/
	.EVEN

;END OF "MODTRN"
;"EVAL"   - EVALUATES A 5TH ORDER POLYNOMIAL 

;"EVAL" COMPUTES THE DESIRED PERCENTAGE CHANGE IN SET POINTS BASED
;UPON THE FRACTION OF TIME THAT HAS ELAPSED SINCE THE START OF A
;MOTION.  IF "PTIME" IS THE TIME FOR WHICH THE SET POINT EVALUATION
;IS DESIRED AND "TTIME" IS THE TOTAL MOTION TIME, THE DESIRED
;PERCENTAGE CHANGE IN SET POINT WILL BE:
;
;		% CHANGE = 6.0*T↑5 -15*T↑4 +6*T↑3 -1
;  WHERE       	       T = PTIME/TTIME
;
;A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;			MOV	PTIME,R0
;			MOV	#JTARAY,R1
;			MOV	TTIME,R2
;			JSR	PC,EVAL
;
;THE PERCENTAGE CHANGE IS RETURNED IN R0 WHERE 1.0 = '40000. IF PTIME
;IS GREATER THAN OR EQUAL TO TTIME, R0 IS SET TO ZERO AND THE 
;"FINAL" FLAG BIT IS SET IN "ARMS".

;REGISTERS USED:
;	R0,R2 PASS ARGUMENTS AND ARE ALTERED
;	R1,R3 ARE GARBAGED

EVAL:	CMP	R2,R0		;PAST END OF TRAJECTORY?
	BLE	TRJEND		;YES
	CLR	R1		;% TIME = (PTIME/TTIME)
	ASHC	@#KM1,R0	
	DIV	R2,R0
	ASR	R2		;ROUND
	SUB	R2,R1
	BMI	.+4
	INC	R0
	MOV	#60000,R2	;6.0 x T
	MUL	R0,R2
	ROL	R3
	ADC	R2
	SUB	#74000,R2	;- 15.0
	MUL	R0,R2		;x T
	ASHC	@#K1,R2
	ROL	R3
	ADC	R2
	ADD	#50000,R2	;+ 10.0
	MOV	#3,R1		;x T**3
TCUBE:	MUL	R0,R2
	ASHC	@#K2,R2
	ROL	R3
	ADC	R2
	SOB	R1,TCUBE
	MOV	R2,R0
	SUB	#40000,R0	;-1.0
	BR	EVALDN

TRJEND:	CLR	R0		;USE FINAL SET POINT
	BIS	#FINAL,@#ARMS	;SET POINT EVALUATION DONE

EVALDN:	RTS	PC

;END OF "EVAL"
;"TIMER"  - COMPUTE TOTAL MOTION TIME

;DETERMINES THE TOTAL TIME REQUIRED FOR AN ARM MOTION BY COMPUTING
;THE INDIVIDUAL TIMES REQUIRED BY EACH JOINT AND TAKING THE LARGEST.
;A SAMPLE CALLING SEQUENCE TO THIS ROUTINE FOLLOWS:
;
;			MOV	#CHANGE,R0
;			JSR	PC,TIMER
;			MOV	R0,TIME
;
;THE ONLY ARGUMENT TO THIS ROUTINE IS A POINTER TO A TABLE CONTAINING
;THE CHANGE IN THE JOINT ANGLES FOR THE DESIRED MOTION.

;REGISTERS USED:
;	R0 PASSES ARGUMENTS AND IS ALTERED
;	R1,R2,R3,R4 ARE GARBAGED

TIMER:	MOV	R5,-(SP)
	MOV	R0,R5
	MOV	#SPEEDS,R1	;TABLE OF MAXIMUM JOINT SPEEDS
	MOV	#6,R4		;SIX JOINTS TO TIME
	CLR	R0		;MAXIMUM TRAVERSE TIME
SPDLP:	MOV	(R5)+,R2	;COMPUTE JT TRAVERSE TIME
	BGE	.+4
	NEG	R2
	MUL	(R1)+,R2
	ROL	R3		;ROUND UP
	ADC	R2
	CMP	R2,R0		;KEEP MAXIMUM TIME
	BLE	.+4
	MOV	R2,R0
	SOB	R4,SPDLP
	TST	R0		;TIME = 0?
	BEQ	ZEROT
	ADD	@#EXTIME,R0	;ADD A LITTLE TIME FOR SHORT MOVES
	BVC	.+6
	MOV	#77700,R0	;SET TO MAX IF OVERFLOW
ZEROT:	MOV	@#NSPEED,R2	;USER REQUESTED CHANGED?
	BNE	ISNSPD		;YES
	MOV	@#PSPEED,R2	;PERMANENT CHANGE SET?
	BEQ	TMEDNE		;NO
ISNSPD:	MUL	R2,R0		;YES, CORRECT
	CLR	@#NSPEED	;ONLY USE ONCE
	ASHC	@#KM9,R0	;NORMALIZE
	TST	R0		;SET TO MAX IF OVERFLOW
	BNE	MAXTME
	MOV	R1,R0
	BPL	.+6
MAXTME:	MOV	#77700,R0	;MAXIMUM PERMITTED TIME
TMEDNE:	MOV	(SP)+,R5
	RTS	PC

;END OF "TIMER"
;"GETBLK" - FREE STORAGE ALLOCATOR

;RETURNS A BLOCK OF FREE STORAGE AREA EQUAL IN SIZE TO THE NUMBER OF
;WORDS REQUESTED.  THE WORDS CONTAINED IN THE BLOCK ARE ALWAYS
;INITIALIZED TO ZERO.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#BLKSIZ,R0	;NUMBER OF WORDS NEEDED
;		JSR	PC,GETBLK
;		BCS	ERROR		;NO FREE STORAGE LEFT
;
;ON EXITING, THIS ROUTINE LEAVES A POINTER TO THE START OF THE FREE
;STORAGE AREA IN R0.  THIS IS A PTR TO THE FIRST WORD THAT CAN BE
;USED BY THE CALLER, NOT A PTR TO THE BOUNDARY TAG INFORMATION.

GETBLK:	MOV	R2,-(SP)
	ASL	R0		;CONVERT FROM WORD TO BYTE COUNT
	CMP	(R0)+,(R0)+	;+ 4 BYTES FOR BOUNDARY TAGS
       	MOV	@#FSPTR,R1 	;PTR TO FIRST FREE BLOCK
	BNE	FRTRY 		;INITIALIZE?

;INITIALIZE FREE STORAGE AREA

	MOV	#FREEST,R1	;MARK AREA ABOVE AND BELOW F.S. BUSY
	MOV	#-1,(R1)+
	MOV	@#HICORE,R2
	MOV	#-1,(R2)
	MOV	R1,@#FSPTR	;MAKE WHOLE AREA INTO ONE LARGE BLOCK
	MOV	R2,-(SP)	;COMPUTE LENGTH OF LARGE BLOCK
	SUB	R1,(SP)
	MOV	(SP),(R1) 	;LOWER BOUNDARY TAG
	MOV	(SP)+,-(R2)	;UPPER BOUNDARY TAG
	
;GET THE REQUIRED SPACE

FRTRY:	CMP 	R1,@#HICORE	;OFF END OF FREE STORAGE?
	BLO  	FR2		;NO 
	MOV 	#FREEST,R1	;YES, RESET PTR TO BEGINNING.
FR2:	TST 	(R1)		;IS THIS AREA BUSY?
	BLE 	FRNEG		;YES 
	CMP 	(R1),R0		;ENOUGH ROOM HERE?
	BGE 	FFOUND		;YES
	ADD 	(R1),R1		;ON TO NEXT, LOC[LTAG[NEXT]
	BR 	FR1
FRNEG:	SUB 	(R1),R1		;LOC[LTAG[NEXT]
FR1:	CMP 	R1,@#FSPTR	;CYCLED THROUGH ALL FREE STORAGE?
	BNE 	FRTRY		;NO, TRY AGAIN
	MOV	#NOFRES,R1	;RAN OUT OF ROOM, SIGNAL ERROR
	MOV	#CANPRO,@#ARMS
	SEC
	BR	GETBDN

FFOUND:	BEQ 	FEXACT		;IF 0 THEN EXACT FIT
	MOV 	R1,R2		;DIVID BLOCK INTO FOUND AND HOLE
	ADD 	R0,R2		;LOC[LTAG[HOLE]]
	NEG 	R0		;BUSY COUNT OF FOUND.
	MOV 	R0,-2(R2)	;RTAG[FOUND] ← NEW FOUND COUNT 
	MOV 	R0,-(SP)
	ADD 	(R1),R0		;LTAG[HOLE] ← NEW HOLE COUNT
	MOV 	R0,(R2)
	MOV 	R2,@#FSPTR	;LOC[LTAG[HOLE]]
	MOV 	R1,R2
	TST 	-(R2)
	ADD 	(R1),R2		;LOC[RTAG[HOLE]].
	MOV 	R0,(R2)		;RTAG[HOLE] ← NEW HOLE COUNT 
	MOV 	(SP)+,(R1)+	;LTAG[FOUND] ← NEW FOUND COUNT
	BR 	FRRET

FEXACT:	MOV 	R1,R2
	ADD 	(R1),R2		;LOC[RTAG[FOUND]]
	NEG 	(R1)+		;SET BOUNDARY TAGS TO BUSY
	NEG 	-(R2)

FRRET:	MOV 	R1,R0		;LOC[LTAG[FOUND]] + 1.
	MOV 	-2(R0),R2
	NEG 	R2		;LENGTH COUNT IN WORDS
	ASR 	R2
	SUB 	#2,R2
	CLR 	(R1)+		;CLEAR THE BLOCK 
	SOB 	R2,.-2

GETBDN:	MOV	(SP)+,R2
	RTS	PC

;END OF "GETBLK"
;"RELBLK" - RETURNS FREE STORAGE BLOCK 

;THIS IS CALLED TO RELEASE A BLOCK OF FREE STORAGE AREA FROM USE.  A
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#BLOCK,R0	;PTR TO BLOCK TO BE RELEASED
;		JSR	PC,GETBLK
;
;NO ERROR MESSAGE IS RETURNED BY THIS ROUTINE

;REGISTERS USED:
;	R0 PASSES ARGUMENTS AND R0 AND R1 ARE GARBAGED

RELBLK:	TST	-(R0)		;LTAG[BLOCK]
	MOV 	R0,R1		;LOC[LTAG[BLOCK]]
	SUB 	(R0),R0		;LOC[LTAG[HIGH]]
	NEG 	(R1)		;SIGNAL NOT BUSY
	TST 	-2(R1)		;IS LOW AVAILABLE?
	BLT 	MERGR		;NO, CANNOT MERGE
	ADD 	-2(R1),(R1)	;YES,  LTAG[BLOCK] ← NEW COUNT
	MOV 	(R1),-2(R0)	;RTAG[BLOCK] ← NEW COUNT
	MOV 	R0,R1
	SUB 	-2(R1),R1	;R1 ← LOC[LTAG[LOW]]
	MOV 	-2(R0),(R1)	;LTAG[LOW] ← NEW COUNT

MERGR:	TST 	(R0)		;IS HIGH AVAILABLE?
	BLT 	RLRET		;NO
	ADD 	(R0),(R1)	;LTAG[BLOCK] ← NEW COUNT
	CMP 	@#FSPTR,R0	;WILL FSPTR POINT INTO VACUUM?
	BNE 	RL1		;NO 
	MOV 	R1,@#FSPTR	;YES, RESET FSPTR ← LOC[LTAG[BLOCK]]
RL1:	ADD 	(R0),R0		;R0 ← LOC[RTAG[HIGH]] + 2

RLRET:	MOV 	(R1),-2(R0)	;RTAG[BLOCK] ← NEW COUNT
	RTS PC

;END OF "RELBLK"
;"TYPERR" - TYPES OUT ERROR MESSAGES

;THE ERROR CODE MUST BE LOADED INTO R1 BEFORE ENTERING THIS
;ROUTINE.  A SAMPLE CALLING SEQUENCE FOLLOWS:
;
;		MOV	#ERRCODE,R1
;		JSR	PC,TYPERR

;REGISTERS USED:
;	R1 PASSES ARGUMENTS AND R1 & SG ARE ALTERED

TYPERR:	MOV	R0,-(SP)
	MOV	R2,-(SP)
	MOV	#MNOSOL,SG	;SPECIAL CASE OF NO SOLUTION?
	BIT	#NOSOL,R1
	BNE	1$		;YES
	BIT	#NOTIME,R1	;TIME OUT ERROR?
	BEQ	REGERR
	MOV	#MNOTIM,SG	;YES

1$:	JSR	PC,TYPSTR	;TYPE ERROR MESSAGE
	MOV	#'0,R0		;START WITH CODE= 0
	MOV	#OUTBUF,SG
	BIC	#NOSOL+NOTIME,R1;GET JOINT BITS
	BEQ	3$		;ERROR CODE = 0?
2$:	INC	R0
	ASR	R1
	BCC	4$
3$:	MOVB	R0,(SG)+	;SAVE JT #
	MOVB	#40,(SG)+
4$:	BNE	2$
	CLRB	(SG)
	BR	TYPNUM		;TYPE OUT ERROR CODE

REGERR:	MOV	ERRMES(R1),SG	;PUT UP ERROR MESSAGE
	CMP	#UHALT,R1	;USER HALT INSTRUCTION?
	BNE	TYPEDN		;NO
	JSR	PC,TYPSTR	;YES, TYPE 1ST PART OF MES
	MOV	#OUTBUF,SG	;GET SUBR NAME AND LINE NUMBER
	MOV	@#SUBPTR,R1
	MOV	(R1)+,R2	;FINAL STEP PTR
	MOV	(R1),R0		;CURRENT SUBR SYM BLK PTR
	CMP	#SUBSTK,R1	;MAIN PROGRAM?
	BNE	1$		;NO, SUBR
	MOV	#"ST,(SG)+	;PACK "STEP "
	MOV	#"EP,(SG)+
	MOVB	#' ,(SG)+
	BR	2$
1$:	JSR	PC,PACNMS	;"NAME-"
	MOVB	#'-,(SG)+
2$:	MOV	R0,R1		;COMPUTE FINAL STEP NUMBER
	CLR	R0
3$:	MOV	(R1),R1		;KEEP MOVING
	INC	R0
	CMP	R1,R2		;FOUND STEP?
	BNE	3$		;NO
	JSR	PC,PTSINT	;YES, CONVERT TO ASCII

TYPNUM:	MOV	#OUTBUF,SG	;NOW TYPE IT

TYPEDN:	JSR	PC,LINOUT
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	RTS	PC

;END OF "TYPERR"
;ERROR CODE BITS

RELCNT	==0
INT	IMPOSS	;IMPOSSIBLE ERROR MESSAGE
INT	UNKFUN	;UNKNOWN FUNCTION NAME SPECIFIED
INT	BIGSYM	;MORE THAN 6 CHARACTERS USED IN SYMBOL NAME
INT	NOFRES	;FREE STORAGE EXHAUSTED
INT	NOARGU	;NO ARGUMENT FOUND
INT	NOCOMA	;STRANGE CHARACTER BEFORE COMMA
INT	BADNUM	;INVALID NUMBER DECODED
INT	ADCERR	;ADC NOT WORKING
INT	NOPROG	;NO PROGRAM NAME SPECIFIED
INT	BADSTP	;INVALID PROGRAM STEP NUMBER
INT	NULPRG	;EMPTY PROGRAM, NO STEPS
INT	NOTDAT	;NO TRANSFORMATION DATA
INT	PANBUT	;PANIC BUTTON HIT
INT	NOHDWR	;HARDWARE SERVO NOT ENABLED
INT	CNTPRO	;CANT PROCEED
INT	RUNERR	;RUNSUB TOOK TOO LONG TO EXECUTE
INT	BADCLS	;HAND CLOSED TO FAR
INT	BADJTN	;ILLEGAL JOINT NUMBER SPECIFIED
INT	OUTRNG	;POSITION OUT OF RANGE
INT	GOODBY	;EXITING TO ODT
INT	UHALT 	;USER PROGRAM HALTED
INT	ABORT 	;ABORT TYPEOUT
INT	SYNERR	;SYNTAX ERROR WHILE SCANNING FOR TOKEN
INT	GOODLD	;GOOD LOAD FROM HSR
INT	FINI  	;USER PROGRAM COMPLETED
INT	BADFRE	;F.S. AREA ALL SCREWED UP
INT	SUBERR	;SUBR STACK EXHAUSTED
INT	RETERR	;TRIED RETURN FROM MAIN PROGRAM
INT	CNTSGS	;CANT SINGLE STEP FROM THIS POINT
INT	BADCMP	;BAD COMPARISON OPERATOR
INT	BADLIN	;CANT INTERPRET INPUT LINE
INT	BADLBL	;BAD LABEL
INT	ARITHO	;ARITHMETIC OVERFLOW
INT	NOOPER	;NO ARITHMETIC OPERATION FOUND
INT	MISLBL	;BRANCH TO MISSING LABEL
INT	DUPLBL
NOSOL 	=1000	;NO VALID ARM SOLUTION
NOTIME	=2000	;FUNCTION TOOK TOO LONG TO EXECUTE

;OUTPUT STRINGS FOR ERROR CODES

ERRMES:	.WORD	MIMPOS,	MUNKFU,	MBIGSY,	MNOFRE,	MNOARG,	MNOCOM
	.WORD	MBADNU,	MADCER,	MNOPRO,	MBADST,	MNULPR
	.WORD	MNOTDA, MPANBU, MNOHDW, MCNTPR, MRUNER, MBADCL
	.WORD	MBADJT, MOUTRN, MGOODB, MUHALT, MABORT, MSYNER
	.WORD	MGOODL, MFINI,  MBADFR, MSUBER, MRETER, MCNTSG
	.WORD	MBADCM, MBADLI, MBADLB, MARITH, MNOOPE
	.WORD	MMISLB
	.WORD	MDUPLB
;ERROR MESSAGE STRINGS

MIMPOS:	.ASCIZ	/**SYSTEM ERROR, REPORT THIS TO VICTOR SCHEINMAN**/
MFINI:	.ASCIZ	/PROGRAM COMPLETED/
MNOARG:	.ASCIZ	/**NO ARGUMENT FOUND WHEN EXPECTED**/
MUNKFU:	.ASCIZ	/**UNDEFINED FUNCTION SPECIFIED**/
MBIGSY:	.ASCIZ	/**MORE THAN 6 CHARACTERS USED IN SYMBOL NAME**/
MNOFRE:	.ASCIZ	/**FREE STORAGE EXHAUSTED**/
MNOCOM:	.ASCIZ	/**UNEXPECTED CHARACTER BEFORE COMMA**/
MBADNU:	.ASCIZ	/**INVALID NUMBER ENCOUNTERED**/
MADCER:	.ASCIZ	/**ANALOG TO DIGITAL CONVERTED NOT WORKING**/
MNOPRO:	.ASCIZ	/**NO PROGRAM NAME SPECIFIED**/
MBADST:	.ASCIZ	/**INVALID SPECIFICATION OF PROGRAM STEPS**/
MNULPR:	.ASCIZ	/**NO PROGRAM STEPS DEFINED**/
MNOSOL:	.ASCIZ	/**REQUIRED ARM SOLUTION DOES NOT EXIST**, CODE=/
MNOTDA:	.ASCIZ	/**TRANSFORM POSITION NOT YET DEFINED**/
MPANBU:	.ASCIZ	/**SOMEONE HIT THE PANIC BUTTON**/
MNOHDW:	.ASCIZ	/**HARDWARE SERVO NOT ENABLED**/
MNOTIM:	.ASCIZ	/**FUNCTION TOOK TOO LONG TO EXECUTE**, CODE=/
MRUNER:	.ASCIZ	/**RUN-TIME FUNCTION CLOCK OVER RUN**/
MBADCL:	.ASCIZ	/**HAND CLOSED TOO FAR**/
MBADJT:	.ASCIZ	/**ILLEGAL JOINT NUMBER SPECIFIED**/
MOUTRN:	.ASCIZ	/**REQUIRED POSITION OUT OF RANGE**/
MGOODB:	.ASCIZ	/EXITING TO ODT!/
MUHALT:	.ASCIZ	/HALTED AT /
MCNTPR:	.ASCII	/**CAN'T PROCEED FROM THIS POINT, USE /
	.ASCIZ	/"EXEC" INSTRUCTION**/
MABORT:	.ASCIZ	/
ABORTED/
MSYNER:	.ASCIZ	/**ERROR WHILE SCANNING FOR TOKEN**/
MGOODL:	.ASCIZ	/LOADING COMPLETED/
MBADFR:	.ASCIZ	/**FREE STORAGE AREA IN WRONG FORMAT**/
MRETER:	.ASCIZ	/**ATTEMPTED TO EXECUTE A "RETURN" WHILE IN MAIN PROGRAM**/
MSUBER:	.ASCIZ	/**TOO MANY "GOSUB"'S EXECUTED**/
MCNTSG:	.ASCII	/**CAN'T SINGLE STEP FROM THIS POINT, USE /
	.ASCIZ	/"EXEC" INSTRUCTION**/
MBADCM:	.ASCIZ	/**ILLEGAL COMPARISON OPERATOR**/
MBADLI:	.ASCIZ	/**CAN'T INTERPRET INPUT LINE**/
MBADLB:	.ASCIZ	/**INVALID LABEL ENCOUNTERED**/
MARITH:	.ASCIZ	/**ARITHMETIC OVERFLOW**/
MNOOPE:	.ASCIZ	/**NO ARITHMETIC OPERATION FOUND WHERE EXPECTED**/
MMISLB:	.ASCIZ	/**ATTEMPTED BRANCH TO NON-EXISTANT LABEL**/
MDUPLB:	.ASCIZ	/**DUPLICATE LABEL DEFINED**/
	.EVEN

;END OF ERROR MESSAGES